home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-04
/
bipl.zip
/
PROCS.ZIP
/
FULLIMAG.ICN
< prev
next >
Wrap
Text File
|
1992-09-28
|
3KB
|
120 lines
############################################################################
#
# File: fullimage.icn
#
# Subject: Procedures to produce complete image of structured data
#
# Author: Robert J. Alexander
#
# Date: December 5, 1989
#
###########################################################################
#
# fullimage() -- enhanced image()-type procedure that outputs all data
# contained in structured types. The "level" argument tells it how far
# to descend into nested structures (defaults to unlimited).
#
############################################################################
global fullimage_level,fullimage_maxlevel,fullimage_done,fullimage_used,
fullimage_indent
procedure fullimage(x,indent,maxlevel)
local tr,s,t
#
# Initialize
#
tr := &trace ; &trace := 0 # turn off trace till we're done
fullimage_level := 1
fullimage_indent := indent
fullimage_maxlevel := \maxlevel | 0
fullimage_done := table()
fullimage_used := set()
#
# Call fullimage_() to do the work.
#
s := fullimage_(x)
#
# Remove unreferenced tags from the result string, and even
# renumber them.
#
fullimage_done := table()
s ? {
s := ""
while s ||:= tab(upto('\'"<')) do {
case t := move(1) of {
"\"" | "'": {
s ||:= t
while (s ||:= tab(find(t) + 1)) \ 1 & s[-2] ~== "\\"
}
"<": {
t := +tab(find(">")) & move(1)
if member(fullimage_used,t) then {
/fullimage_done[t] := *fullimage_done + 1
s ||:= "<" || fullimage_done[t] || ">"
}
}
}
}
s ||:= tab(0)
}
#
# Clean up and return.
#
fullimage_done := fullimage_used := &null # remove structures
&trace := tr # restore &trace
return s
end
procedure fullimage_(x,noindent)
local s,t,tr
t := type(x)
s := case t of {
"null" | "string" | "integer" | "real" | "co-expression" | "cset" |
"file" | "window" | "procedure" | "external": image(x)
default: fullimage_structure(x)
}
#
# Return the result.
#
return (
if \fullimage_indent & not \noindent then
"\n" || repl(fullimage_indent,fullimage_level - 1) || s
else
s
)
end
procedure fullimage_structure(x)
local sep,s,t,tag,y
#
# If this structure has already been output, just output its tag.
#
if \(tag := fullimage_done[x]) then {
insert(fullimage_used,tag)
return "<" || tag || ">"
}
#
# If we've reached the max level, just output a normal image
# enclosed in braces to indicate end of the line.
#
if fullimage_level = fullimage_maxlevel then
return "{" || image(x) || "}"
#
# Output the structure in a style indicative of its type.
#
fullimage_level +:= 1
fullimage_done[x] := tag := *fullimage_done + 1
if (t := type(x)) == ("table" | "set") then x := sort(x)
s := "<" || tag || ">" || if t == "list" then "[" else t || "("
sep := ""
if t == "table" then every y := !x do {
s ||:= sep || fullimage_(y[1]) || "->" || fullimage_(y[2],"noindent")
sep := ","
}
else every s ||:= sep || fullimage_(!x) do sep := ","
fullimage_level -:= 1
return s || if t == "list" then "]" else ")"
end